COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		title outdd
C00006 00003	setpp,erase
C00007 ENDMK
C⊗;
	title outdd
	entry outdd
	extern outstr,corget,correl

;procedure outdd(string s; integer string_begin,pppos);

a←1 ↔ b←2 ↔ c←3 ↔ d←4 ↔ e←5 ↔ f←6
pnt←10 ↔ len←11 ↔ spos←13 ↔ ppos← 7
sp←16 ↔ p←17

;THIS←←2 ↔ SIZ←←3

dddlin ←←20000

buffpt:	200000,,0			;double field mode
	0
	0
	0

cpopj:	popj p,
outdd:
	move spos,-2(p)			;position of first line
	pop p,-2(p)
	pop p,ppos			;page printer position
	
	movni a,1
	getlin a			;get type of terminal
	tlnn a,dddlin
	jrst outstr			;not a dd - let outstr handle it.

	jumpge spos,noerase		;if string position < 0 erase screen
	pushj p,erase
	movm spos,spos

noerase:
	caile spos,=39
	movei spos,=39

	pop sp,pnt			;get string byte pointer
	pop sp,len			;get length of string
	hrre len,len
	jumple len,cpopj		;null string
	movei c,6(len)			;find number of words for string
	idivi c,5
	addi c,3
	pushj p,corget
	halt

	hrrm b,buffpt
	hrrm c,buffpt+1
	movei a,1(b)
	hrrm a,buffpt+3

	move d,[point 7,0]		;copy string
	hrri d,2(b)
	move e,spos
	subi e,=40			;number of lines to bottom
d1:	ildb a,pnt
	cain a,12			;look for line feeds
	aojge e,bottom			;e contains count of line feeds
	idpb a,d
	sojg len,d1

	movei a,15			;append a <crlf> to the string
	idpb a,d
	movei a,12
	idpb a,d

bottom:
	jumpge ppos,pp
	movn ppos,ppos			;if ppos < 0 relative to last line of string
	add ppos,e
	addi ppos,=40

pp:	pushj p,setpp			;set the page printer

	hrlzi a,-3(c)			;set bit 35 of ascii string words to 1
	movn a,a
	hrri a,2(b)
	movei d,1
d2:	orm d,(a)
	aobjn a,d2

	move a,[BYTE (8) 46,0,46 (3) 1,2,1,4]
	movem a,(b)
	move a,[BYTE (8) 2,0,0 (3)3,4,5,4]
	movem a,1(b)

	imuli spos,=12
	move d,spos
	andi d,17			;low 4 bits
	andi spos,760			;high 5 bits
	lsh spos,-4
	move a,[point 8,1(b),7]
	idpb spos,a
	idpb d,a
	
	DDUPG	BUFFPT

	pushj p,correl

	popj p,
;setpp,erase

setpp:	caile ppos,=39
	movei ppos,=39
	caige ppos,0
	movei ppos,0

	movn a,ppos
	addi a,=40
	lsh a,=9
	imul ppos,[-31463146]			; -2000,,0/=39
	ash ppos,-=18
	dpypos 1000(ppos)
	dpysiz 1(a)
	popj p,

ersbuf:	BYTE (8) 17,0,46 (3) 1,2,1,4	;funct. code, chan select, funct. code
	0
erspt:	ersbuf
	erspt-ersbuf
	0
	0

erase:	ddupg	erspt
	popj	p,


	end